home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / p4 / p4-1_2c.lha / p4-1.2c / messages_f / sr_test.f < prev    next >
Text File  |  1993-05-24  |  3KB  |  124 lines
  1.       program systest
  2.  
  3.       include 'p4f.h'
  4.  
  5.       call p4init()
  6.       call p4crpg()
  7.       if (p4myid() .eq. 0) then
  8.       call fmaster()
  9.       else
  10.       call fworker()
  11.       endif
  12.       call p4cleanup()
  13.       print *,'mainline exiting normally'
  14.       end
  15.  
  16.  
  17.       subroutine fmaster()
  18.  
  19.       include 'p4f.h'
  20.  
  21.       integer*4 i,slaves,toid,type,from,retcde,recvlen,buflen,length
  22.       character*40 buffer
  23.       integer*4 TAGCNT, TAGDAT, TAGEND
  24.       parameter (TAGCNT = 10)
  25.       parameter (TAGDAT = 20)
  26.       parameter (TAGEND = 30)
  27.  
  28.       print 11,'Entering fmaster'
  29. 11    format(a)
  30.       slaves = p4ntotids() - 1
  31.       length = 0
  32.       buflen = 40
  33.  
  34.       do 10 i = 1,slaves
  35.          call p4sendr(TAGCNT,i,buffer,length,retcde)
  36. 10    continue
  37.  
  38. 20    print *,'Enter a string: '
  39.       read (*,99,end=50) buffer
  40. 99    format(a40)
  41.  
  42.       do 30 length=40,1,-1
  43.          if(buffer(length:length) .ne. ' ') goto 40
  44. 30    continue
  45.       length = 0
  46. 40    continue
  47.  
  48.       toid = 1
  49.       print *,'master sending msg of length ',length
  50.       call p4send(TAGDAT,toid,buffer,length,retcde)
  51.       buffer = ' '
  52.       type = TAGDAT
  53.       from = -1
  54.       call p4recv(type,from,buffer,buflen,recvlen,retcde)
  55.  
  56.       print *,'MASTER receives from=',from,' buffer=',buffer
  57.       length = 0
  58.       goto 20
  59. 50    continue
  60.  
  61.       do 60 i = 1,slaves
  62.          call p4sendr(TAGEND,i,buffer,buflen,retcde)
  63. 60    continue
  64.  
  65.       print *,'Master exiting normally'
  66.       end
  67.  
  68.  
  69.       subroutine fworker()
  70.  
  71.       include 'p4f.h'
  72.  
  73.       character*40 buffer
  74.       integer*4 type, from, next, done, procid, length, buflen
  75.       integer*4 numsl, retcde, recvlen
  76.       integer*4 TAGCNT, TAGDAT, TAGEND
  77.       parameter (TAGCNT = 10)
  78.       parameter (TAGDAT = 20)
  79.       parameter (TAGEND = 30)
  80.  
  81.       numsl = p4ntotids() - 1
  82.       procid = p4myid()
  83.       buflen = 40
  84.  
  85.       print 200,'slave ',procid,' has started'
  86.  200  format(a,i2,a)
  87.       call p4flush
  88.  
  89.       if (procid .eq. numsl) then
  90.          next = 0
  91.       else
  92.          next = procid + 1
  93.       endif
  94.  
  95.       print 201,'slave ',procid,' next = ',next
  96.  201  format(a,i2,a,i2)
  97.       call p4flush
  98.  
  99.       length = 40
  100.       from = -1
  101.       type = TAGCNT
  102.       call p4recv(type,from,buffer,length,recvlen,retcde)
  103.       call p4flush
  104.       done = 0
  105.  
  106. 50    if (done .ne. 0) goto 100
  107.  
  108.          buffer = ' '
  109.          length = 40
  110.          from = -1
  111.          type = -1
  112.          call p4recv(type,from,buffer,length,recvlen,retcde)
  113.          call p4flush
  114.          if (type .eq. TAGEND) then
  115.             done = 1
  116.          else
  117.             call p4send(TAGDAT,next,buffer,recvlen,retcde)
  118.          endif
  119.          goto 50
  120.  
  121. 100   continue
  122.  
  123.       end
  124.